home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #11 / Amiga Plus CD - 2002 - No. 11.iso / Tools / Development / PowerD / powerd / source / ddbg.d < prev    next >
Encoding:
Text File  |  2002-10-28  |  34.2 KB  |  1,370 lines
  1. /*
  2. ** ddbg - PowerD programming language debugger by MarK
  3. */
  4.  
  5. MODULE    'exec/memory'
  6.  
  7. CONST    VER=0,
  8.         REV=20,
  9.         MAXVER=VER<<16|REV
  10.  
  11. RAISE    "^C" IF CtrlC()=TRUE
  12.  
  13. DEF    pool,exe:PTR TO exe
  14.  
  15. BYTE    0,0,'$VER:ddbg v0.2 (23.6.2002)',0,0
  16.  
  17. PROC main()
  18.     DEF    ra=NIL,args=[0,0]:LONG,n,str[256]:STRING
  19.     ENUM    EXE,ARGS
  20.     IFN ra:=ReadArgs('EXE/A,ARGS',args,NIL) THEN Raise("IO")
  21.     IFN pool:=CreatePool(MEMF_CLEAR|MEMF_PUBLIC,16384,1024) THEN Raise("MEM")
  22.     exe:=LoadExecutable(args[EXE])
  23.     exe.src:=LoadDSource(EStringF(str,'\s.d',args[EXE]))
  24.     exe.debug:=LoadDebugFile(EStringF(str,'\s.debug',args[EXE]))
  25.  
  26.     n:=0
  27.     WHILE exe.hunks[n]
  28. //        DisAsmHunk68k(exe.hunks[n],Long(exe.hstarts[n]),exe.hsymbols[n])
  29. //        ViewSymbols(exe.hsymbols[n])
  30.         n++
  31.     ENDWHILE
  32.  
  33. //    ViewHex(exe.file,exe.length/4)
  34.  
  35.     setupscreen()
  36.     openmainwindow()
  37.     opensrcwindow()
  38.  
  39.     // setup code for running
  40.     RunCustomCode([IF args[ARGS] THEN StrLen(args[ARGS]) ELSE 0,0,0,0,0,0,0,0,args[ARGS],0,0,0,0,0,0,0,0]:UL)
  41. EXCEPTDO
  42.     closemainwindow()
  43.     closedownscreen()
  44.     IF pool THEN DeletePool(pool)
  45.     IF ra THEN FreeArgs(ra)
  46.     SELECT exception
  47.     CASE "IO";    PrintFault(IOErr(),'ddbg')
  48.     CASE "MEM";    PrintF('\s: \s\n','ddbg','not enough memory')
  49.     CASE "BADF";PrintF('\s: \s\n','ddbg','bad file type')
  50.     CASE "VERS";PrintF('\s: \s\n','ddbg','newer version of ddbg required')
  51.     CASE $000003ef;PrintF('\s: \s\n','ddbg','ext hunk is not supported')
  52.     CASE $000003f0;PrintF('\s: \s\n','ddbg','symbol hunk is not supported')
  53.     CASE $000003f1;PrintF('\s: \s\n','ddbg','debug hunk is not supported')
  54.     CASE "DSTH";PrintF('\s: \s\n','ddbg','no destination hunk available')
  55.     CASE "GTLI";PrintF('\s: \s\n','ddbg','can''t open gadtools.library v37+')
  56.     CASE "GADG";PrintF('\s: \s\n','ddbg','can''t create gadgets')
  57.     CASE "MENU";PrintF('\s: \s\n','ddbg','can''t create menus')
  58.     CASE "WIND";PrintF('\s: \s\n','ddbg','can''t open window')
  59.     CASE "WBSC";PrintF('\s: \s\n','ddbg','can''t lock Workbench screen')
  60.     CASE "VISU";PrintF('\s: \s\n','ddbg','can''t get visual info')
  61.     CASE "TYPE";PrintF('\s: \s\n','ddbg','bad debug file')
  62.     CASE "RTLI";PrintF('\s: \s\n','ddbg','can''t open reqtools.library v37+')
  63.     ENDSELECT
  64. ENDPROC
  65.  
  66. OBJECT exe
  67.     pc:PTR,                // pc address to run on
  68.     regs:PTR TO UL,    // d0-a7,sr register contents
  69.     file:PTR TO CHAR,
  70.     length,
  71.     start:UL,
  72.     stop:UL,
  73.     hunks:PTR TO PTR,
  74.     hstarts:PTR TO PTR,
  75.     hsymbols:PTR TO PTR,
  76.     relocated:PTR TO CHAR,
  77.     breakpoints:PTR TO breakpoint,
  78.     debug:PTR TO debug,
  79.     src:PTR TO src
  80.  
  81. PROC LoadExecutable(name:PTR TO CHAR)(PTR TO exe)
  82.     DEF    file=NIL,length,exe:PTR TO exe
  83.     IFN exe:=AllocVecPooled(pool,SIZEOF_exe) THEN Raise("MEM")
  84.     IF (length:=FileLength(name))<=0 THEN Raise("IO")
  85.     exe.length:=length
  86.     IFN file:=Open(name,OLDFILE) THEN Raise("IO")
  87.     IFN exe.file:=AllocVecPooled(pool,length+16) THEN Raise("MEM")
  88.     Read(file,exe.file,length)
  89.     Close(file)
  90.     file:=NIL
  91.  
  92.     // count and reloc all hunks available in the executable file
  93.     DEF    mem:PTR TO CHAR,h,i,j,k,count,n,hunklist=NIL:PTR TO PTR,hunkstarts=NIL:PTR TO PTR,hunksymbols=NIL:PTR TO PTR,hunktoreloc,ops=FALSE
  94.     FOR n:=0 TO 2
  95.         mem:=exe.file
  96.         hunktoreloc:=NIL
  97.         SELECT n
  98.         CASE 0
  99.             PrintF('Reading...\n')
  100.         CASE 1
  101.             PrintF('# of hunks: \d\n',count)
  102.             IFN exe.hunks:=AllocVecPooled(pool,(count+2)*SIZEOF_PTR) THEN Raise("MEM")
  103.             hunklist:=exe.hunks
  104.             IFN exe.hstarts:=AllocVecPooled(pool,(count+2)*SIZEOF_PTR) THEN Raise("MEM")
  105.             hunkstarts:=exe.hstarts
  106.             IFN exe.hsymbols:=AllocVecPooled(pool,(count+2)*SIZEOF_PTR) THEN Raise("MEM")
  107.             hunksymbols:=exe.hsymbols
  108.         CASE 2
  109.             PrintF('Relocating...\n')
  110.             hunklist:=exe.hunks
  111.             hunkstarts:=exe.hstarts
  112.             hunksymbols:=exe.hsymbols
  113.         ENDSELECT
  114.         count:=0
  115.         WHILE mem<=(length+exe.file)
  116.             SELECT Long(mem)
  117.             CASE $000003e7,$0000003e8    // hunk unit, name
  118.                 mem+=4
  119.                 i:=Long(mem)
  120.                 mem+=4+AlignLong(i)
  121.             CASE $000003e9,$000003ea,$000003eb    // hunk code, data, bss
  122. //                PrintF('code/data\n')
  123.                 mem+=4
  124.                 i:=Long(mem)*4
  125.                 mem+=4
  126.                 hunktoreloc:=mem
  127.                 SELECT n
  128.                 CASE 1
  129.                     hunkstarts[count]:=mem-8
  130.                     hunklist[count]:=mem
  131. //                    VPrintF('hunklist: \h,\h,\h,\h\n',hunklist)
  132.                 ENDSELECT
  133.                 count++
  134.                 mem+=i
  135.             CASE $000003ec,$000003ed,$000003ee    // hunk reloc32, reloc16, reloc8
  136. //                PrintF('reloc\n')
  137.                 j:=Long(mem)
  138.                 mem+=4
  139.                 SELECT n
  140.                 CASE 0,1
  141.                     WHILE i:=Long(mem)
  142.                         mem+=8
  143.                         mem+=i*4
  144.                         CtrlC()
  145.                     ENDWHILE
  146.                     mem+=4
  147. //                    PrintF('mem1: \d\n',mem)
  148.                 CASE 2
  149.                     WHILE i:=Long(mem)
  150. //                        PrintF('\h: \h\n',hunklist[Long(mem+4)],Long(mem+4))
  151.                         IFN h:=hunklist[Long(mem+4)] THEN Raise("DSTH")
  152.                         mem+=8
  153.                         FOR k:=0 TO i-1
  154.                             SELECT j
  155.                             CASE $000003ec;    PutLong(hunktoreloc+Long(mem),h+ULong(hunktoreloc+Long(mem)))
  156.                             CASE $000003ed;    PutWord(hunktoreloc+Long(mem),h+UWord(hunktoreloc+Long(mem)))
  157.                             CASE $000003ee;    PutByte(hunktoreloc+Long(mem),h+UByte(hunktoreloc+Long(mem)))
  158.                             ENDSELECT
  159.                             mem+=4
  160.                         ENDFOR
  161.                         CtrlC()
  162.                     ENDWHILE
  163.                     mem+=4
  164. //                    PrintF('mem2: \d\n',mem)
  165.                 ENDSELECT
  166.             CASE $000003ef    // hunk ext    UNSUPPORTED
  167.                 Raise(Long(mem))
  168.             CASE $000003f0
  169.                 mem+=4
  170.                 SELECT n
  171.                 CASE 1
  172.                     IF count>0    // this should be enough to become safe, it's always the first argument
  173.                         hunksymbols[count-1]:=mem
  174.                     ENDIF
  175.                 ENDSELECT
  176.                 WHILE i:=Long(mem)
  177.                     mem+=(i+2)*4
  178.                     CtrlC()
  179.                 ENDWHILE
  180.                 mem+=4
  181.             CASE $000003f1 // hunk debug UNSUPPORTED
  182.                 Raise(Long(mem))
  183.             CASE $000003f2    // hunk end
  184. //                PrintF('end\n')
  185.                 mem+=4
  186.                 hunktoreloc:=NIL
  187.             CASE $000003f3    // hunk header
  188. //                PrintF('head\n')
  189.                 mem+=4
  190.  
  191.                 WHILE i:=Long(mem)    // skip names
  192.                     mem+=4
  193.                     mem+=i*4
  194.                     CtrlC()
  195.                 ENDWHILE
  196.                 mem+=4
  197.  
  198.                 mem+=4                // highest hunk number +1
  199.                 i:=Long(mem)        // first
  200.                 j:=Long(mem+4)        // last
  201.                 mem+=8
  202.  
  203.                 mem+=(j-i+1)*4        // skip sizes
  204.             CASE $000003f7,$000003f8,$000003f9,$000003fc    // hunk drel32, drel16, drel8, reloc32short
  205.                 mem+=4
  206.                 SELECT n
  207.                 CASE 0,1
  208.                     WHILE i:=Word(mem)
  209.                         mem+=4
  210.                         mem+=i*2
  211.                         CtrlC()
  212.                     ENDWHILE
  213.                     mem+=2
  214.                 CASE 2
  215.                     WHILE i:=Word(mem)
  216. //                        PrintF('\h: \h\n',hunklist[Word(mem+2)],Word(mem+2))
  217.                         IFN h:=hunklist[Word(mem+2)] THEN Raise("DSTH")
  218.                         mem+=4
  219.                         FOR k:=0 TO i-1
  220.                             SELECT j
  221.                             CASE $000003ec;    PutLong(hunktoreloc+Word(mem),h+ULong(hunktoreloc+Word(mem)))
  222.                             CASE $000003ed;    PutWord(hunktoreloc+Word(mem),h+UWord(hunktoreloc+Word(mem)))
  223.                             CASE $000003ee;    PutByte(hunktoreloc+Word(mem),h+UByte(hunktoreloc+Word(mem)))
  224.                             ENDSELECT
  225.                             mem+=2
  226.                         ENDFOR
  227.                         CtrlC()
  228.                     ENDWHILE
  229.                     mem+=2
  230.  
  231.                     WHILE i:=Word(mem)
  232.                         h:=Word(mem+2)
  233.                         mem+=4
  234.                         mem+=i*2
  235.                         CtrlC()
  236.                     ENDWHILE
  237.                     mem+=2
  238.                 ENDSELECT
  239.             CASE 0;    ops:=TRUE
  240.             DEFAULT
  241.                 PrintF('$\h\n',Long(mem))
  242.             ENDSELECT
  243.         EXITIF ops DO ops:=FALSE
  244.             CtrlC()
  245.         ENDWHILE
  246.     ENDFOR
  247.  
  248.     exe.start:=exe.file
  249.     exe.stop:=exe.file+exe.length
  250.  
  251. EXCEPTDO
  252.     IF file THEN Close(file)
  253.     IF exception THEN Raise(exception)
  254. ENDPROC exe
  255. /*
  256. PROC DisAsmHunk68k(pos:PTR TO CHAR,hunktype:UL,symbols=NIL)
  257.     DEF    max,start
  258.     start:=pos
  259.     max:=Long(pos-4)*4
  260.     max+=pos
  261.     PrintF('hunk: \h, start: \h, stop: \h\n',hunktype,pos,max)
  262.     WHILE (pos:=DisAsm68k(pos,hunktype,FindLabel(start,pos,symbols)))<max
  263.         CtrlC()
  264.     ENDWHILE
  265. ENDPROC
  266.  
  267. PROC FindLabel(start,addr,symlist:PTR TO LONG)(PTR)
  268.     DEF    lab=NIL,i
  269.     IF symlist=NIL THEN RETURN NIL
  270. //    PrintF('\d\t',addr-start)
  271.     WHILE i:=Long(symlist)
  272.     EXITIF (addr-start)=symlist[i+1] DO lab:=symlist+4
  273.         symlist+=(i+2)*4
  274.         CtrlC()
  275.     ENDWHILE
  276. ENDPROC lab
  277.  
  278. PROC FindLabelGlobal(addr)(PTR)
  279.     DEF    lab=NIL,i,n=0,start,symlist:PTR TO L
  280.     WHILE symlist:=exe.hsymbols[n]
  281.         start:=exe.hunks[n]
  282. //        PrintF('\d: \h,\h,\h\n',n,start,addr,addr-start)
  283.         WHILE i:=Long(symlist)
  284.         EXITIF (addr-start)=symlist[i+1] DO lab:=symlist+4
  285.             symlist+=(i+2)*4
  286.             CtrlC()
  287.         ENDWHILE
  288.         n++
  289.     ENDWHILE
  290. ENDPROC lab
  291. */
  292.  
  293. PROC FindLabelAddr(name:PTR TO CHAR)(UL)
  294.     DEF    lab=NIL,i,n=0,start,symlist:PTR TO L,addr
  295.     WHILE symlist:=exe.hsymbols[n]
  296.         start:=exe.hunks[n]
  297.         WHILE i:=Long(symlist)
  298.         EXITIF StrCmp(name,symlist+4) DO addr:=start+symlist[i+1]
  299. //        EXITIF (addr-start)=symlist[i+1] DO lab:=symlist+4
  300.             symlist+=(i+2)*4
  301.             CtrlC()
  302.         ENDWHILE
  303.         n++
  304.     ENDWHILE
  305. ENDPROC addr
  306.  
  307. // get, if there is a line label on a given address
  308. PROC FindLineAddr(addr)(UL)
  309.     DEF    lab=NIL,i,n=0,start,symlist:PTR TO L
  310.     WHILE symlist:=exe.hsymbols[n]
  311.         start:=exe.hunks[n]
  312. //        PrintF('\d: \h,\h,\h\n',n,start,addr,addr-start)
  313.         WHILE i:=Long(symlist)
  314.             IF (addr-start)=symlist[i+1]
  315.                 lab:=symlist+4
  316.                 IF StrCmp(lab,'line_',5) THEN RETURN lab
  317.             ENDIF
  318.             lab:=NIL
  319.             symlist+=(i+2)*4
  320.             CtrlC()
  321.         ENDWHILE
  322.         n++
  323.     ENDWHILE
  324. ENDPROC lab
  325.  
  326. /*
  327. PROC DisAsm68k(inst:PTR TO CHAR,hunktype,label=NIL:PTR TO CHAR)(PTR)
  328.     DEF    istr=NIL:PTR TO CHAR,i,a1[64]:CHAR,a2[64]:CHAR,q1=FALSE,q2=FALSE,type,str:PTR TO CHAR
  329.     IF label
  330.         PrintF('$\z\h[8]: \s\s',inst,label,IF StrLen(label)>4 THEN '\t' ELSE '\t\t')
  331.     ELSE
  332.         PrintF('$\z\h[8]:\t\t',inst)
  333.     ENDIF
  334.     IF hunktype=$000003ea
  335.         PrintF('$\z\h[4]\n',UWord(inst))
  336.         RETURN inst+2
  337.     ENDIF
  338.     SELECT i:=UWord(inst)
  339.     CASE $4e71;    istr:='nop';    inst+=2
  340.     CASE $4e75;    istr:='rts';    inst+=2
  341.     DEFAULT
  342.         SELECT (i&$ff00)>>8
  343.         CASE %01001110
  344.             SELECT (i&$00c0)>>6
  345.             CASE %01
  346.                 SELECT (i&$0038)>>3
  347.                 CASE %010;    istr:='link'
  348.                     inst+=2
  349.                     DisArg68k(a1,(i&7)|8,inst);                q1:=TRUE
  350.                     inst:=DisArg68k(a2,%111100,inst,"w");    q2:=TRUE
  351.                 CASE %011;    istr:='unlk'
  352.                     inst+=2
  353.                     DisArg68k(a1,(i&7)|8,inst);                q1:=TRUE
  354.                 DEFAULT;    PrintF('$\z\h[4]',i);    inst+=2
  355.                 ENDSELECT
  356.             CASE %10;    istr:='jsr';    inst+=2
  357.             DEFAULT;    PrintF('$\z\h[4]',i)
  358.             ENDSELECT
  359.             IF istr
  360.                 inst:=DisArg68k(a1,(i&$003f),inst);        q1:=TRUE
  361.             ENDIF
  362.         DEFAULT
  363.             SELECT (i&$c000)>>14
  364.             CASE %00    // move
  365.                 SELECT (i&$3000)>>12
  366.                 CASE %01;    istr:='move.b'
  367.                 CASE %10;    istr:='move.l'
  368.                 CASE %11;    istr:='move.w'
  369.                 DEFAULT;    PrintF('$\z\h[4]',i)
  370.                 ENDSELECT
  371.                 inst+=2
  372.                 IF istr
  373.                     inst:=DisArg68k(a1,(i&$003f),inst);        q1:=TRUE
  374.                     inst:=DisArg68k(a2,(i&$0e00)>>9|(i&$01c0)>>3,inst);    q2:=TRUE
  375.  
  376. //                    inst:=DisArg68k(a2,(i&$0fc0)>>6,inst);    q2:=TRUE
  377.                 ENDIF
  378.             CASE %01    // moveq, lea
  379.                 SELECT (i&$3000)>>12
  380.                 CASE %00
  381.                     SELECT (i&$01c0)>>6
  382.                     CASE %010;    istr:='movem.w'
  383.                         SELECT (i&$0e00)>>9
  384.                         CASE %100
  385.                             DisRegList68k(a1,UWord(inst+2),-1);    q1:=TRUE;    inst+=4
  386.                             inst:=DisArg68k(a2,i,inst);            q2:=TRUE
  387.                         CASE %110
  388.                             DisRegList68k(a2,UWord(inst+2),+1);    q2:=TRUE;    inst+=4
  389.                             inst:=DisArg68k(a1,i,inst);            q1:=TRUE
  390.                         DEFAULT;    PrintF('\z\h[4]',i)
  391.                             inst+=2
  392.                         ENDSELECT
  393.                     CASE %011;    istr:='movem.l'
  394.                         SELECT (i&$0e00)>>9
  395.                         CASE %100
  396.                             DisRegList68k(a1,UWord(inst+2),-1);    q1:=TRUE;    inst+=4
  397.                             inst:=DisArg68k(a2,i,inst);            q2:=TRUE
  398.                         CASE %110
  399.                             DisRegList68k(a2,UWord(inst+2),+1);    q2:=TRUE;    inst+=4
  400.                             inst:=DisArg68k(a1,i,inst);            q1:=TRUE
  401.                         DEFAULT;    PrintF('\z\h[4]',i)
  402.                             inst+=2
  403.                         ENDSELECT
  404.                     CASE %111;    istr:='lea'
  405.                         inst+=2
  406.                         inst:=DisArg68k(a1,(i&$003f),inst);    q1:=TRUE
  407.                         StringF(a2,'a\d',(i&$0e00)>>9);        q2:=TRUE
  408.                     DEFAULT;    PrintF('\z\h[4]',i)
  409.                         inst+=2
  410.                     ENDSELECT
  411.                 CASE %10
  412.                     str:=DisCC68k((i&$0f00)>>8)
  413.                     istr:='b\0\0\0\0\0\0\0'
  414.                     istr[1]:="\0"    // needed, because else it won't restore those zero bytes each time
  415.                     StrAdd(istr,str)
  416.                     inst+=2
  417.                     q1:=TRUE
  418.                     IF i&$ff=$00
  419.                         StrAdd(istr,'.w')
  420.                         inst:=DisArg68k(a1,%111000,inst,"r")
  421.                     ELSEIF i&$ff=$ff
  422.                         StrAdd(istr,'.l')
  423.                         inst:=DisArg68k(a1,%111001,inst,"l")
  424.                     ELSE
  425.                         StrAdd(istr,'.b')
  426.                         DisArg68k(a1,%111001,inst,"b")
  427.                     ENDIF
  428.                 CASE %11
  429.                     SELECT (i&$0100)>>8
  430.                     CASE %0;    istr:='moveq';    StringF(a1,'#\d',Byte(inst+1));    q1:=TRUE;    StringF(a2,'d\d',(i&$0e00)>>9);    q2:=TRUE
  431.                     ENDSELECT
  432.                     inst+=2
  433.                 DEFAULT;    PrintF('\z\h[4]',i)
  434.                     inst+=2
  435.                 ENDSELECT
  436.             CASE %11    // add
  437.                 SELECT (i&$3000)>>12
  438.                 CASE %01
  439.                     inst+=2
  440.                     inst,type:=DisOpArg68k(a1,a2,i,inst);    q1:=q2:=TRUE
  441.                     SELECT type
  442.                     CASE "b";    istr:='add.b'
  443.                     CASE "w";    istr:='add.w'
  444.                     CASE "l";    istr:='add.l'
  445.                     ENDSELECT
  446.                 DEFAULT;    PrintF('$\z\h[4]',i)
  447.                     inst+=2
  448.                 ENDSELECT
  449.             DEFAULT;    PrintF('$\z\h[4]',i)
  450.                 inst+=2
  451.             ENDSELECT
  452.         ENDSELECT
  453.     ENDSELECT
  454.     PrintF('\s',istr)
  455.     IF q1
  456.         PrintF('\t\s',a1)
  457.         IF q2 THEN PrintF(',\s',a2)
  458.     ENDIF
  459.     PrintF('\n')
  460. ENDPROC inst
  461.  
  462. PROC DisArg68k(str:PTR TO CHAR,i,inst:PTR TO CHAR,type="l")(PTR)
  463.     DEF    lab
  464.     SELECT (i&$38)>>3
  465.     CASE %000;    StringF(str,'d\d',i&7)
  466.     CASE %001;    StringF(str,'a\d',i&7)
  467.     CASE %010;    StringF(str,'(a\d)',i&7)
  468.     CASE %011;    StringF(str,'(a\d)+',i&7)
  469.     CASE %100;    StringF(str,'-(a\d)',i&7)
  470.     CASE %101;    StringF(str,'(\d,a\d)',Word(inst),i&7);    inst+=2
  471.     CASE %111
  472.         SELECT i&7
  473.         CASE %000
  474.             SELECT type
  475.             CASE "r"
  476.                 IF lab:=FindLabelGlobal(Word(inst)+inst)
  477.                     StringF(str,'\s',lab)
  478.                 ELSE
  479.                     StringF(str,'$\z\h[8]',Word(inst)+inst)
  480.                 ENDIF
  481.                 inst+=2
  482.             DEFAULT
  483.                 StringF(str,'$\z\h[4].w',UWord(inst))
  484.                 inst+=2
  485.             ENDSELECT
  486.         CASE %001;
  487.             SELECT type
  488.             CASE "b"        // for bcc/dbcc/bra only
  489.                 IF lab:=FindLabelGlobal(Byte(inst-1)+inst)
  490.                     StringF(str,'\s',lab)
  491.                 ELSE
  492.                     StringF(str,'$\z\h[8]',Byte(inst-1)+inst)
  493.                 ENDIF
  494.             CASE "l"
  495.                 IF lab:=FindLabelGlobal(Long(inst))
  496.                     StringF(str,'\s',lab)
  497.                 ELSE
  498.                     StringF(str,'$\z\h[8].l',Long(inst))
  499.                 ENDIF
  500.                 inst+=4
  501.             ENDSELECT
  502.         CASE %010;    StringF(str,'(\d,pc)',Word(inst));    inst+=2
  503.         CASE %100;
  504.             SELECT type
  505.             CASE "w";    StringF(str,'#\d',Word(inst));    inst+=2
  506.             CASE "l";    StringF(str,'#\d',Long(inst));    inst+=4
  507.             ENDSELECT
  508.         DEFAULT;    StringF(str,'???')
  509.         ENDSELECT
  510.     DEFAULT;    StringF(str,'???')
  511.     ENDSELECT
  512. ENDPROC inst
  513.  
  514. PROC DisOpArg68k(s1:PTR TO CHAR,s2:PTR TO CHAR,i,inst:PTR TO CHAR)(PTR,L)
  515.     DEF    type
  516.     SELECT (i&$01e0)>>6
  517.     CASE %000;    type:="b";    inst:=DisArg68k(s1,i&$3f,inst,"w");    DisArg68k(s2,i>>9&7)
  518.     CASE %001;    type:="w";    inst:=DisArg68k(s1,i&$3f,inst,"w");    DisArg68k(s2,i>>9&7)
  519.     CASE %010;    type:="l";    inst:=DisArg68k(s1,i&$3f,inst);    DisArg68k(s2,i>>9&7)
  520.     CASE %011;    type:="w";    inst:=DisArg68k(s1,i&$3f,inst,"w");    DisArg68k(s2,i>>9&7|8)
  521.     CASE %100;    type:="b";    DisArg68k(s1,i>>9&7);    inst:=DisArg68k(s2,i&$3f,inst,"w")
  522.     CASE %101;    type:="w";    DisArg68k(s1,i>>9&7);    inst:=DisArg68k(s2,i&$3f,inst,"w")
  523.     CASE %110;    type:="l";    DisArg68k(s1,i>>9&7);    inst:=DisArg68k(s2,i&$3f,inst)
  524.     CASE %111;    type:="l";    inst:=DisArg68k(s1,i&$3f,inst);    DisArg68k(s2,i>>9&7|8)
  525.     ENDSELECT
  526. ENDPROC inst,type
  527.  
  528. PROC DisCC68k(cc)(PTR)
  529.     DEF    str:PTR TO CHAR
  530.     SELECT cc&%1111
  531.     CASE %0000;    str:='f'
  532.     CASE %0001;    str:='t'
  533.     CASE %0010;    str:='hi'
  534.     CASE %0011;    str:='ls'
  535.     CASE %0100;    str:='cc'
  536.     CASE %0101;    str:='cs'
  537.     CASE %0110;    str:='ne'
  538.     CASE %0111;    str:='eq'
  539.     CASE %1000;    str:='vc'
  540.     CASE %1001;    str:='vs'
  541.     CASE %1010;    str:='pl'
  542.     CASE %1011;    str:='mi'
  543.     CASE %1100;    str:='ge'
  544.     CASE %1101;    str:='lt'
  545.     CASE %1110;    str:='gt'
  546.     CASE %1111;    str:='le'
  547.     ENDSELECT
  548. ENDPROC str
  549.  
  550. PROC DisRegList68k(str:PTR TO CHAR,word,dir)(PTR)
  551.     DEF    n,haveany=FALSE,tmp[6]:STRING,min,max,step,i
  552.     SetEStr(str,0)
  553.     min:=0
  554.     max:=15
  555.     IF dir<0
  556.         n:=max
  557.         step:=-1
  558.     ELSE
  559.         n:=min
  560.         step:=1
  561.     ENDIF
  562.     i:=0
  563.     WHILE n>=min AND n<=max
  564.         IF word&1<<n
  565.             IF haveany THEN EStrAdd(str,'/')
  566.             EStringF(tmp,'\c\d',IF i<=7 THEN "d" ELSE "a",i&7)
  567.             EStrAdd(str,tmp)
  568.             haveany:=TRUE
  569.         ENDIF
  570.         i++
  571.         n+=step
  572.     ENDWHILE
  573. ENDPROC str
  574. */
  575.  
  576. PROC AlignLong(i)(L)
  577.     SELECT i&%11
  578.     CASE %01    i+=3
  579.     CASE %10    i+=2
  580.     CASE %11    i+=1
  581.     ENDSELECT
  582. ENDPROC i
  583.  
  584. OBJECT src
  585.     src:PTR TO CHAR,
  586.     length:L,
  587.     linecount:L,
  588.     lines:PTR TO PTR TO CHAR,
  589.     showline:L,
  590.     line:L
  591.  
  592. PROC LoadDSource(name:PTR TO CHAR)(PTR)
  593.     DEF    src:PTR TO src,mem:PTR TO CHAR,len,pos,file
  594.     IF (len:=FileLength(name))<=0 THEN Raise("IO")
  595.     IFN file:=Open(name,OLDFILE) THEN Raise("IO")
  596.     IFN src:=AllocVecPooled(pool,SIZEOF_src) THEN Raise("MEM")
  597.     IFN mem:=AllocVecPooled(pool,len+16) THEN Raise("MEM")
  598.     IF Read(file,mem,len)<>len THEN Raise("IO")
  599. //    Write(stdout,mem,len)
  600.     src.src:=mem
  601.     src.length:=len
  602.  
  603.     DEF    count=1
  604.     pos:=0
  605.     // count lines
  606.     WHILE pos<len
  607.         IF mem[pos]="\n"
  608.             count++
  609.         ENDIF
  610.         pos++
  611.     ENDWHILE
  612.     src.linecount:=count
  613.  
  614.     // setup lines
  615.     IFN src.lines:=AllocVecPooled(pool,(count+1)*SIZEOF_PTR) THEN Raise("MEM")
  616.     count:=0
  617.     pos:=0
  618.     src.lines[count++]:=mem+pos
  619.     WHILE pos<len
  620.         IF mem[pos]="\n"
  621.             mem[pos]:="\0"    // terminate the line
  622.             src.lines[count++]:=mem+pos+1
  623.         ENDIF
  624.         pos++
  625.     ENDWHILE
  626.  
  627.     src.showline:=-1    // don't jump to the line
  628. EXCEPTDO
  629.     IF file THEN Close(file)
  630.     IF exception THEN Raise(exception)
  631. ENDPROC src
  632.  
  633. OBJECT debug
  634.     var:PTR TO var,
  635.     proc:PTR TO proc
  636.  
  637. OBJECT var
  638.     name:PTR TO CHAR,
  639.     offset:LONG,
  640.     type:LONG,
  641.     ofto:LONG,
  642.     view:BOOL,
  643.     next:PTR TO var
  644.  
  645. OBJECT proc
  646.     name:PTR TO CHAR,
  647.     var:PTR TO var,
  648.     next:PTR TO proc
  649.  
  650. PROC LoadDebugFile(filename:PTR TO CHAR)(PTR)
  651.     DEF    file=NIL,length,debug=NIL:PTR TO debug,mem=NIL:PTR TO CHAR,pos,name:PTR TO CHAR,proc:PTR TO proc,var:PTR TO var,val
  652.     DEF    global=FALSE
  653.     IF (length:=FileLength(filename))<=0 THEN Raise("IO")
  654.     IFN file:=Open(filename,OLDFILE) THEN Raise("IO")
  655.     IFN mem:=AllocVecPooled(pool,length+16) THEN Raise("MEM")
  656.     IFN debug:=AllocVecPooled(pool,SIZEOF_debug) THEN Raise("MEM")
  657.     IF Read(file,mem,length)<>length THEN Raise("IO")
  658.     IF Long(mem)<>"DDBG" THEN Raise("TYPE")
  659.     pos:=Skip(mem,4,length)
  660.     WHILE pos<length
  661.         name:=mem+pos
  662.         pos:=MakeName(mem,pos,length)
  663.         pos:=Skip(mem,pos+1,length)
  664.         IF StrCmp(name,'PROC')
  665.             IFN proc:=AllocVecPooled(pool,SIZEOF_proc) THEN Raise("MEM")
  666.             proc.next:=debug.proc
  667.             IFN debug.proc THEN debug.proc:=proc
  668.             debug.proc:=proc
  669.             name:=mem+pos
  670.             pos:=MakeName(mem,pos,length)
  671.             pos:=Skip(mem,pos+1,length)
  672.             proc.name:=name
  673. //            PrintF('PROC \s\n',proc.name)
  674.             LOOP
  675.                 name:=mem+pos
  676.                 pos:=MakeName(mem,pos,length)
  677.                 pos:=Skip(mem,pos+1,length)
  678.             EXITIF StrCmp(name,'ENDPROC')
  679.  
  680.                 DoVariable
  681.  
  682.                 CtrlC()
  683.             ENDLOOP
  684.         ELSEIF StrCmp(name,'GLOBALS')
  685.             pos:=Skip(mem,pos,length)
  686.             global:=TRUE
  687.             LOOP
  688.                 name:=mem+pos
  689.                 pos:=MakeName(mem,pos,length)
  690.                 pos:=Skip(mem,pos+1,length)
  691.             EXITIF StrCmp(name,'ENDGLOBALS')
  692.  
  693.                 DoVariable
  694.  
  695.                 CtrlC()
  696.             ENDLOOP
  697.             global:=FALSE
  698.         ELSE
  699.             Raise("TYPE")
  700.         ENDIF
  701.         CtrlC()
  702.     ENDWHILE
  703.  
  704.     SUB DoVariable
  705.         IFN var:=AllocVecPooled(pool,SIZEOF_var) THEN Raise("MEM")
  706.         IF global
  707.             var.next:=debug.var
  708.             IFN debug.var THEN debug.var:=var
  709.             debug.var:=var
  710.         ELSE
  711.             var.next:=proc.var
  712.             IFN proc.var THEN proc.var:=var
  713.             proc.var:=var
  714.         ENDIF
  715.         val:=Val(name)
  716.         var.offset:=val
  717.  
  718.         name:=mem+pos
  719.         pos:=MakeName(mem,pos,length)
  720.         pos:=Skip(mem,pos+1,length)
  721.         var.name:=name
  722. //        PrintF('VAR \s(\d)\n',var.name,var.offset)
  723.         
  724.         name:=mem+pos
  725.         pos:=MakeName(mem,pos,length)
  726.         pos:=Skip(mem,pos+1,length)
  727.         val:=Val(name)
  728.         var.type:=val
  729.  
  730.         IF (val&$1f)=10
  731.             name:=mem+pos
  732.             pos:=MakeName(mem,pos,length)
  733.             pos:=Skip(mem,pos+1,length)
  734.             var.ofto:=name
  735.         ENDIF
  736.     ENDSUB
  737. EXCEPTDO
  738.     IF file THEN Close(file)
  739.     IF exception THEN Raise(exception)
  740. ENDPROC debug
  741.  
  742. PROC MakeName(src:PTR TO CHAR,pos,length)(L)
  743.     WHILE IsAlpha(src[pos]) OR IsNum(src[pos]) OR src[pos]="_" OR src[pos]="-"
  744.         pos++
  745.         CtrlC()
  746.     ENDWHILE
  747.     src[pos]:="\0"
  748. ENDPROC pos
  749.  
  750. PROC Skip(src:PTR TO CHAR,pos,length)(L)
  751.     LOOP
  752.         IF src[pos]=" "
  753.         ELSEIF src[pos]="\n"
  754.         ELSEIF src[pos]="\t"
  755.         ELSEIF src[pos]="\0"
  756.         ELSE
  757.             RETURN pos
  758.         ENDIF
  759.         pos++
  760.         IF pos>=length THEN RETURN pos
  761.         IF (pos\100)=0 THEN CtrlC()
  762.     ENDLOOP
  763. ENDPROC pos-1
  764. /*
  765. PROC ViewHex(data:PTR TO L,length,max=8)
  766.     DEF    count=0,inter
  767.     WHILE count<length
  768.         inter:=0
  769.         WHILE inter<max
  770.             PrintF('$\z\h[8]',data[count+inter])
  771.             inter++
  772.         EXITIF inter+count>=length DO PrintF('\n')
  773.             IF inter=8 THEN PrintF('\n') ELSE PrintF(',')
  774.             CtrlC()
  775.         ENDWHILE
  776.         count+=inter
  777.         CtrlC()
  778.     ENDWHILE
  779. ENDPROC
  780.  
  781. PROC ViewSymbols(symlist:PTR TO LONG)
  782.     DEF    i
  783.     WHILE i:=Long(symlist)
  784.         PrintF('$\z\h[8]: \s\n',symlist[i+1],symlist+4)
  785.         symlist+=(i+2)*4
  786.         CtrlC()
  787.     ENDWHILE
  788. ENDPROC
  789. */
  790.  
  791. // view the PowerD source code
  792. PROC UpdateSrc()
  793.     DEF    str[256]:STRING,start,max
  794.     DEF    line,width,n,a,b
  795.     IFN srcwnd THEN RETURN
  796.     max:=(srcwnd.Height-srcwnd.BorderTop-srcwnd.BorderBottom)/srcwnd.RPort.Font.YSize
  797.     width:=srcwnd.Width-srcwnd.BorderLeft-srcwnd.BorderRight
  798.  
  799.     IF exe.src.showline=TRUE
  800.         start:=exe.src.line-max/2
  801.     ELSE
  802.         start:=exe.src.showline-max/2
  803.     ENDIF
  804.  
  805.     IF max>exe.src.linecount THEN start:=0
  806.     IF start+max>=exe.src.linecount THEN start:=exe.src.linecount-max
  807.     IF start<0 THEN start:=0
  808.  
  809.     SetRast(srcwnd.RPort,0)        // clear the window
  810.  
  811.     line:=start
  812.     FOR n:=0 TO max-1
  813.         EStringF(str,'\z\d[5]: \s',line+1,exe.src.lines[line])
  814.         WHILE TextLength(srcwnd.RPort,str,EStrLen(str))>width
  815.             SetEStr(str,EStrLen(str)-1)
  816.         ENDWHILE
  817.         ConvStr(str)
  818.         a:=IF line=exe.src.line THEN 2 ELSE 1
  819.         b:=IF line=exe.src.line THEN 1 ELSE 0
  820.         IF line=exe.src.showline
  821.             a:=3
  822.             b:=2
  823.         ENDIF
  824.         SetAPen(srcwnd.RPort,a)
  825.         SetBPen(srcwnd.RPort,b)
  826.         Move(srcwnd.RPort,4,(n*srcwnd.RPort.Font.YSize)+srcwnd.RPort.Font.Baseline)
  827.         Text(srcwnd.RPort,str,EStrLen(str))
  828.     EXITIF line>=exe.src.linecount
  829.         line++
  830.         CtrlC()
  831.     ENDFOR
  832.     EStringF(str,'\d',max)
  833.     Move(srcwnd.RPort,srcwnd.Width-200,20)
  834.     Text(srcwnd.RPort,str,EStrLen(str))
  835. ENDPROC
  836.  
  837. PROC ConvStr(str:PTR TO CHAR)
  838.     DEF    n=0
  839.     WHILE str[n]<>0
  840.         IF str[n]="\t"
  841.             str[n]:=" "
  842.         ENDIF
  843.         n++
  844.     ENDWHILE
  845. ENDPROC
  846.  
  847. PROC UpdateVars()
  848.     DEF    proc:PTR TO proc,var:PTR TO var,value,a5,field
  849.     DEF    str[128]:STRING,n,width,strb[64]:STRING,addr
  850.     IFN varwnd THEN RETURN
  851.     width:=varwnd.Width-varwnd.BorderLeft-varwnd.BorderRight-8
  852.     SetAPen(varwnd.RPort,1)
  853.     proc:=exe.debug.proc
  854.     n:=0
  855.     WHILE proc
  856.         var:=proc.var
  857.         WHILE var
  858.             field:=FALSE
  859.             a5:=exe.regs[8+5]
  860.             SELECT var.type
  861.             CASE 0,1,2;    value:=Long(a5+var.offset)
  862.             CASE 3;        value:=Word(a5+var.offset)
  863.             CASE 4;        value:=UWord(a5+var.offset)
  864.             CASE 5;        value:=Byte(a5+var.offset)
  865.             CASE 6;        value:=UByte(a5+var.offset)
  866.             DEFAULT;        value:=Long(a5+var.offset)
  867.                 IF value&$ff00.0000 THEN field:=TRUE
  868.             ENDSELECT
  869.             EStringF(str,'\s = $\h (\d) (on address: $\z\h[8])',var.name,value,value,a5+var.offset)
  870.             IF field
  871.                 EStringF(strb,'=[$\z\h[8],$\z\h[8],$\z\h[8],$\z\h[8]]',Long(value),Long(value+4),Long(value+8),Long(value+12))
  872.                 EStrAdd(str,strb)
  873.             ENDIF
  874.             WHILE TextLength(varwnd.RPort,str,EStrLen(str))>width
  875.                 SetEStr(str,EStrLen(str)-1)
  876.             ENDWHILE
  877.             Move(varwnd.RPort,4,(n*varwnd.RPort.Font.YSize)+varwnd.RPort.Font.Baseline)
  878.             Text(varwnd.RPort,str,EStrLen(str))
  879.             var:=var.next
  880.             n++
  881.         ENDWHILE
  882.         proc:=proc.next
  883.     ENDWHILE
  884.  
  885.     var:=exe.debug.var
  886.     n:=0
  887.     WHILE var
  888.         field:=FALSE
  889.         EStringF(str,'_\s',var.name)
  890.         addr:=FindLabelAddr(str)
  891.         SELECT var.type
  892.         CASE 0,1,2;    value:=Long(addr)
  893.         CASE 3;        value:=Word(addr)
  894.         CASE 4;        value:=UWord(addr)
  895.         CASE 5;        value:=Byte(addr)
  896.         CASE 6;        value:=UByte(addr)
  897.         DEFAULT;        value:=Long(addr)
  898.             IF value&$ff00.0000 THEN field:=TRUE
  899.         ENDSELECT
  900.         EStringF(str,'\s = $\h (\d) (on address: $\z\h[8])',var.name,value,value,addr)
  901.         IF field
  902.             EStringF(strb,'=[$\z\h[8],$\z\h[8],$\z\h[8],$\z\h[8]]',Long(value),Long(value+4),Long(value+8),Long(value+12))
  903.             EStrAdd(str,strb)
  904.         ENDIF
  905.         WHILE TextLength(varwnd.RPort,str,EStrLen(str))>width
  906.             SetEStr(str,EStrLen(str)-1)
  907.         ENDWHILE
  908.         Move(varwnd.RPort,4,(n*varwnd.RPort.Font.YSize)+varwnd.RPort.Font.Baseline)
  909.         Text(varwnd.RPort,str,EStrLen(str))
  910.         var:=var.next
  911.         n++
  912.     ENDWHILE
  913. ENDPROC
  914.  
  915. PROC UpdateRegs()
  916.     DEF    str[256]:STRING,n,width,strb[128]:STRING
  917.     IFN regwnd THEN RETURN
  918.     width:=regwnd.Width-regwnd.BorderLeft-regwnd.BorderRight-8
  919.     SetAPen(regwnd.RPort,1)
  920.     FOR n:=0 TO 8
  921.         IF n<8
  922.             EStringF(str,'d\d: $\z\h[8] a\d: $\z\h[8] ',n,exe.regs[n],n,exe.regs[n+8])
  923.             IF exe.regs[n+8]&$ff00.0000
  924.                 EStringF(strb,'[$\z\h[8],$\z\h[8],$\z\h[8],$\z\h[8],$\z\h[8],$\z\h[8],$\z\h[8],$\z\h[8]]',ULong(exe.regs[n+8]),ULong(exe.regs[n+8]+4),ULong(exe.regs[n+8]+8),ULong(exe.regs[n+8]+12),ULong(exe.regs[n+8]+16),ULong(exe.regs[n+8]+20),ULong(exe.regs[n+8]+24),ULong(exe.regs[n+8]+28))
  925.                 EStrAdd(str,strb)
  926.             ENDIF
  927.         ELSE
  928.             EStringF(str,'sr: $\z\h[4] pc: $\z\h[8] ',exe.regs[16],exe.pc)
  929.         ENDIF
  930.         WHILE TextLength(regwnd.RPort,str,EStrLen(str))>width
  931.             SetEStr(str,EStrLen(str)-1)
  932.         ENDWHILE
  933.         Move(regwnd.RPort,4,(n*regwnd.RPort.Font.YSize)+regwnd.RPort.Font.Baseline)
  934.         Text(regwnd.RPort,str,EStrLen(str))
  935.     ENDFOR
  936. ENDPROC
  937.  
  938. PROC Update()
  939.     UpdateRegs()
  940.     UpdateVars()
  941.     UpdateSrc()
  942. ENDPROC
  943.  
  944. PROC GetLine(lab:PTR TO CHAR)(L)
  945.     DEF    line,add
  946.     IF StrCmp(lab,'line_',5)=FALSE THEN RETURN TRUE
  947.     lab+=5
  948.     add:=InStr(lab,'_')
  949.     IF add=-1 THEN RETURN TRUE
  950.     lab:=add+1
  951.     line:=Val(lab)
  952.     IF line=0 THEN RETURN TRUE
  953. ENDPROC line-1
  954.  
  955. PROC GetProc(dst:PTR TO CHAR,lab:PTR TO CHAR)(PTR)
  956.     DEF    add
  957.     IF StrCmp(lab,'line_',5)=FALSE THEN RETURN TRUE
  958.     lab+=5
  959.     add:=InStr(lab,'_')
  960.     StrCopy(dst,lab,add-lab)
  961. ENDPROC dst
  962.  
  963. OPT    LINK='*ddbg_trace.o'
  964. RPROC Trace(a0:PTR,a1:PTR)(UL,PTR)
  965.  
  966. DEF    command=NIL,currentproc[64]:CHAR
  967.  
  968. // this is the main procedure, that executes after each instruction of the
  969. // debugger proggy
  970. PROC Test(pc:PTR IN a0,rl:PTR TO UL IN A1)(L)
  971.     DEF    lab:PTR TO CHAR,line,dst[64]:CHAR
  972.     IF pc>exe.start AND pc<exe.stop
  973.         exe.pc:=pc
  974.         exe.regs:=rl
  975.         cicount++
  976.         IF command="in" AND (lab:=FindLineAddr(exe.pc))<>NIL
  977.             command:="st"
  978.             line:=GetLine(lab)
  979.             exe.src.line:=line
  980.             Update()
  981.         ELSEIF command="ov" AND (lab:=FindLineAddr(exe.pc))<>NIL
  982.             IF StrCmp(GetProc(dst,lab),currentproc)
  983.                 command:="st"
  984.                 line:=GetLine(lab)
  985.                 exe.src.line:=line
  986.                 Update()
  987.             ENDIF
  988. //            PrintF('\s\n',dst)
  989.         ELSEIF exe.pc=exe.breakpoints.addr
  990.             PrintF('breakpoint reached!\n')
  991.             command:="st"
  992.             IF lab:=FindLineAddr(exe.pc)
  993.                 line:=GetLine(lab)
  994.                 exe.src.line:=line
  995.                 Update()
  996.             ENDIF
  997.         ELSEIF command="ai"
  998.             command:="st"
  999.             Update()
  1000.         ELSEIF (lab:=FindLineAddr(exe.pc))<>NIL
  1001.             line:=GetLine(lab)
  1002.             exe.src.line:=line
  1003.             Update()
  1004.         ENDIF
  1005. //        PrintF('\c\c ',command>>8,command)
  1006. //        nextinst:=DisAsm68k(pc,0,FindLabelGlobal(exe.pc))
  1007.         IF command="st"
  1008.             command:=Wait4Message(mainwnd)
  1009.             SELECT command
  1010.             CASE "ov"
  1011.                 IF lab THEN StrCopy(currentproc,GetProc(dst,lab))
  1012.             ENDSELECT
  1013.             Wait4Message(regwnd,FALSE)
  1014.             Wait4Message(varwnd,FALSE)
  1015.             Wait4Message(srcwnd,FALSE)
  1016.         ELSE
  1017.             IF Wait4Message(mainwnd,FALSE)
  1018.                 command:="st"
  1019.             ENDIF
  1020.             Wait4Message(regwnd,FALSE)
  1021.             Wait4Message(varwnd,FALSE)
  1022.             Wait4Message(srcwnd,FALSE)
  1023.         ENDIF
  1024.     ENDIF
  1025.     icount++
  1026. ENDPROC FALSE
  1027.  
  1028. OBJECT breakpoint
  1029.     addr:UL,next:PTR TO breakpoint
  1030.  
  1031. PROC RunCustomCode(rl:PTR TO UL)
  1032.     exe.pc:=exe.hunks[0]
  1033.     exe.regs:=rl
  1034.     command:="go"
  1035.     exe.breakpoints:=[FindLabelAddr('_main'),NIL]:breakpoint
  1036.     Trace(exe.pc,&Test)
  1037.     PrintF('total traced instruction count: \d\n',icount)
  1038.     PrintF(' custom code instruction count: \d\n',cicount)
  1039. ENDPROC
  1040.  
  1041. DEF    icount=0,cicount=0
  1042.  
  1043.  
  1044.  
  1045.  
  1046.  
  1047.  
  1048.  
  1049.  
  1050. MODULE 'gadtools',
  1051.        'libraries/gadtools',
  1052.        'intuition/intuition',
  1053.        'intuition/screens',
  1054.        'intuition/gadgetclass',
  1055.        'intuition/iobsolete',
  1056.        'utility/tagitem',
  1057.        'devices/inputevent',
  1058.        'graphics/text'
  1059. MODULE    'reqtools',
  1060.             'libraries/reqtools'
  1061.  
  1062. DEF infos:PTR TO Gadget,
  1063.     mainwnd:PTR TO Window,
  1064.     mainmenus,
  1065.     mainglist,
  1066.     regwnd=NIL:PTR TO Window,
  1067.     varwnd=NIL:PTR TO Window,
  1068.     srcwnd=NIL:PTR TO Window,
  1069.     scr:PTR TO Screen,
  1070.     visual=NIL,
  1071.     offx,offy,
  1072.     tattr:PTR TO TextAttr,
  1073.     id,key,qual,item:PTR TO MenuItem
  1074. DEF    GadToolsBase
  1075. DEF    ReqToolsBase
  1076.  
  1077. PROC setupscreen()
  1078.     IFN GadToolsBase:=OpenLibrary('gadtools.library',37) THEN Raise("GTLI")
  1079.     IFN ReqToolsBase:=OpenLibrary('reqtools.library',37) THEN Raise("RTLI")
  1080.     IFN scr:=LockPubScreen('Workbench') THEN Raise("WBSC")
  1081.     IFN visual:=GetVisualInfoA(scr,NIL) THEN Raise("VISU")
  1082.     offy:=offx:=0
  1083.     tattr:=NIL    //['topaz.font',8,0,0]:TextAttr
  1084. ENDPROC
  1085.  
  1086. PROC closedownscreen()
  1087.     IF visual THEN FreeVisualInfo(visual)
  1088.     IF scr THEN UnlockPubScreen(NIL,scr)
  1089.     IF GadToolsBase THEN CloseLibrary(GadToolsBase)
  1090.     IF ReqToolsBase THEN CloseLibrary(ReqToolsBase)
  1091. ENDPROC
  1092.  
  1093. PROC openmainwindow()
  1094.   DEF g:PTR TO Gadget
  1095.   IFN g:=CreateContext(&mainglist) THEN Raise("GADG")
  1096.   IFN g:=CreateGadgetA(BUTTON_KIND,g,
  1097.     [offx+4,offy+4,33,33,'In',tattr,"in",PLACETEXT_IN,visual,0]:NewGadget,
  1098.     [TAG_END]) THEN Raise("GADG")
  1099.   IFN g:=CreateGadgetA(BUTTON_KIND,g,
  1100.     [offx+40,offy+4,33,33,'Over',tattr,"ov",PLACETEXT_IN,visual,0]:NewGadget,
  1101.     [GA_Disabled,FALSE,TAG_END]) THEN Raise("GADG")
  1102.   IFN g:=CreateGadgetA(BUTTON_KIND,g,
  1103.     [offx+76,offy+4,33,33,'Run',tattr,"go",PLACETEXT_IN,visual,0]:NewGadget,
  1104.     [GA_Disabled,TRUE,TAG_END]) THEN Raise("GADG")
  1105.   IFN g:=CreateGadgetA(BUTTON_KIND,g,
  1106.     [offx+112,offy+4,33,33,'Stop',tattr,"st",PLACETEXT_IN,visual,0]:NewGadget,
  1107.     [GA_Disabled,TRUE,TAG_END]) THEN Raise("GADG")
  1108.   IFN g:=CreateGadgetA(BUTTON_KIND,g,
  1109.     [offx+148,offy+4,33,33,'Asm',tattr,"ai",PLACETEXT_IN,visual,0]:NewGadget,
  1110.     [GA_Disabled,TRUE,TAG_END]) THEN Raise("GADG")
  1111.   IFN g:=CreateGadgetA(BUTTON_KIND,g,
  1112.     [offx+184,offy+4,33,33,'Over',tattr,"ao",PLACETEXT_IN,visual,0]:NewGadget,
  1113.     [GA_Disabled,TRUE,TAG_END]) THEN Raise("GADG")
  1114.   IFN g:=CreateGadgetA(BUTTON_KIND,g,
  1115.     [offx+220,offy+4,33,33,'Raise',tattr,"ra",PLACETEXT_IN,visual,0]:NewGadget,
  1116.     [GA_Disabled,TRUE,TAG_END]) THEN Raise("GADG")
  1117.   IFN mainmenus:=CreateMenus([
  1118.     NM_TITLE,'Debug',            NIL,$0,0,0,
  1119.     NM_ITEM ,'Find...',          'F',$0,0,"FIND",
  1120.     NM_ITEM ,'Next',             'N',$0,0,"NEXT",
  1121.     NM_ITEM ,'Jump to line...',  'L',$0,0,"LINE",
  1122.     NM_ITEM ,NM_BARLABEL,        NIL,$0,0,0,
  1123.     NM_ITEM ,'Regs',             'R',$0,0,"REGS",
  1124. //    NM_ITEM ,'Memory',           NIL,$0,0,0,
  1125.     NM_ITEM ,'Variables',        'V',$0,0,"VARS",
  1126.     NM_ITEM ,NM_BARLABEL,        NIL,$0,0,0,
  1127.     NM_ITEM ,'Refresh',          ' ',$0,0,"REFR",
  1128.     NM_ITEM ,NM_BARLABEL,        NIL,$0,0,0,
  1129.     NM_ITEM ,'Run and Quit',     'Q',$0,0,"QUIT",
  1130.     0,0,0,0,0,0,0]:NewMenu,NIL) THEN Raise("MENU")
  1131.   IF LayoutMenusA(mainmenus,visual,NIL)=FALSE THEN Raise("MENU")
  1132.   IF (mainwnd:=OpenWindowTagList(NIL,
  1133.     [WA_Left,0,
  1134.      WA_Top,scr.BarHeight+1,
  1135.      WA_InnerWidth,257,
  1136.      WA_InnerHeight,41,
  1137.      WA_IDCMP,IDCMP_GADGETUP|IDCMP_MENUPICK|IDCMP_RAWKEY|IDCMP_CLOSEWINDOW,
  1138.      WA_Flags,WFLG_CLOSEGADGET|WFLG_DEPTHGADGET|WFLG_DRAGBAR|WFLG_GIMMEZEROZERO|WFLG_ACTIVATE,
  1139.      WA_Title,'Debugger',
  1140.      WA_CustomScreen,scr,
  1141.      WA_AutoAdjust,TRUE,
  1142.      WA_Gadgets,mainglist,
  1143.      WA_NewLookMenus,TRUE,
  1144.      TAG_END]))=NIL THEN Raise("WIND")
  1145.   IF SetMenuStrip(mainwnd,mainmenus)=FALSE THEN Raise("MENU")
  1146.   GT_RefreshWindow(mainwnd,NIL)
  1147. ENDPROC
  1148.  
  1149. PROC closemainwindow()
  1150.     closeregwindow()
  1151.     closevarwindow()
  1152.     closesrcwindow()
  1153.     IF mainwnd THEN ClearMenuStrip(mainwnd)
  1154.     IF mainmenus THEN FreeMenus(mainmenus)
  1155.     IF mainwnd THEN CloseWindow(mainwnd)
  1156.     IF mainglist THEN FreeGadgets(mainglist)
  1157. ENDPROC
  1158.  
  1159. PROC openregwindow()
  1160.     IFN regwnd:=OpenWindowTags(NIL,
  1161.         WA_Left,scr.Width-160,
  1162.         WA_Top,scr.BarHeight+1,
  1163.         WA_InnerWidth,160,
  1164.         WA_InnerHeight,scr.Font.YSize*9,
  1165.         WA_IDCMP,IDCMP_GADGETUP|IDCMP_MENUPICK|IDCMP_RAWKEY|IDCMP_CLOSEWINDOW|IDCMP_NEWSIZE,
  1166.         WA_Flags,WFLG_CLOSEGADGET|WFLG_DEPTHGADGET|WFLG_DRAGBAR|WFLG_GIMMEZEROZERO|WFLG_SIZEGADGET,
  1167.         WA_Title,'Registers',
  1168.         WA_CustomScreen,scr,
  1169.         WA_AutoAdjust,TRUE,
  1170.         WA_MinHeight,scr.Font.YSize*9,
  1171.         WA_MaxHeight,scr.Font.YSize*9,
  1172.         WA_MinWidth,128,
  1173.         WA_MaxWidth,1024,
  1174.         WA_NewLookMenus,TRUE,
  1175.         TAG_END) THEN Raise("WIND")
  1176.     UpdateRegs()
  1177. ENDPROC
  1178.  
  1179. PROC closeregwindow()
  1180.     IF regwnd THEN CloseWindow(regwnd)
  1181.     regwnd:=NIL
  1182. ENDPROC
  1183.  
  1184. PROC openvarwindow()
  1185.     IFN varwnd:=OpenWindowTags(NIL,
  1186.         WA_Left,0,
  1187.         WA_Top,scr.BarHeight+1,
  1188.         WA_InnerWidth,320,
  1189.         WA_InnerHeight,100,
  1190.         WA_IDCMP,IDCMP_GADGETUP|IDCMP_MENUPICK|IDCMP_RAWKEY|IDCMP_CLOSEWINDOW|IDCMP_NEWSIZE,
  1191.         WA_Flags,WFLG_CLOSEGADGET|WFLG_DEPTHGADGET|WFLG_DRAGBAR|WFLG_GIMMEZEROZERO|WFLG_SIZEGADGET,
  1192.         WA_Title,'Variables',
  1193.         WA_CustomScreen,scr,
  1194.         WA_AutoAdjust,TRUE,
  1195.         WA_MinHeight,64,
  1196.         WA_MaxHeight,1024,
  1197.         WA_MinWidth,128,
  1198.         WA_MaxWidth,1024,
  1199.         WA_NewLookMenus,TRUE,
  1200.         TAG_END) THEN Raise("WIND")
  1201.     UpdateVars()
  1202. ENDPROC
  1203.  
  1204. PROC closevarwindow()
  1205.     IF varwnd THEN CloseWindow(varwnd)
  1206.     varwnd:=NIL
  1207. ENDPROC
  1208.  
  1209. PROC opensrcwindow()
  1210.     IFN srcwnd:=OpenWindowTags(NIL,
  1211.         WA_Left,0,
  1212.         WA_Top,scr.BarHeight+1+100,
  1213.         WA_InnerWidth,640,
  1214.         WA_InnerHeight,300,
  1215.         WA_IDCMP,IDCMP_GADGETUP|IDCMP_MENUPICK|IDCMP_RAWKEY|IDCMP_CLOSEWINDOW|IDCMP_NEWSIZE,
  1216.         WA_Flags,WFLG_CLOSEGADGET|WFLG_DEPTHGADGET|WFLG_DRAGBAR|WFLG_GIMMEZEROZERO|WFLG_SIZEGADGET,
  1217.         WA_Title,'Source',
  1218.         WA_CustomScreen,scr,
  1219.         WA_AutoAdjust,TRUE,
  1220.         WA_MinHeight,64,
  1221.         WA_MaxHeight,1024,
  1222.         WA_MinWidth,128,
  1223.         WA_MaxWidth,1024,
  1224.         WA_NewLookMenus,TRUE,
  1225.         TAG_END) THEN Raise("WIND")
  1226.     UpdateSrc()
  1227. ENDPROC
  1228.  
  1229. PROC closesrcwindow()
  1230.     IF srcwnd THEN CloseWindow(srcwnd)
  1231.     srcwnd:=NIL
  1232. ENDPROC
  1233.  
  1234. PROC Wait4Message(win:PTR TO Window,wait=TRUE)(L)
  1235.     DEF    mes:PTR TO IntuiMessage,type
  1236.     id:=NIL
  1237.     REPEAT
  1238.         type:=0
  1239.         IF mes:=GT_GetIMsg(win.UserPort)
  1240.             type:=mes.Class
  1241.             IF type=IDCMP_MENUPICK
  1242.                 infos:=mes.Code
  1243.                 IF item:=ItemAddress(win.MenuStrip,infos)
  1244.                     id:=Long(item+34)
  1245.                 ELSE
  1246.                     id:=0
  1247.                     type:=0
  1248.                 ENDIF
  1249.             ELSEIF (type=IDCMP_GADGETDOWN) OR (type=IDCMP_GADGETUP)
  1250.                 infos:=mes.IAddress
  1251.                 id:=infos.GadgetID
  1252.             ELSEIF type=IDCMP_VANILLAKEY
  1253.                 key:=mes.Code
  1254.                 qual:=mes.Qualifier AND Not($ffff8200) -> clear unneeded bits
  1255.             ELSEIF type=IDCMP_MOUSEBUTTONS
  1256.                 qual:=mes.Qualifier AND Not($ffff8200) -> clear unneeded bits
  1257.             ELSEIF type=IDCMP_REFRESHWINDOW
  1258.                 GT_BeginRefresh(win)
  1259.                 GT_EndRefresh(win,TRUE)
  1260.                 type:=0
  1261.             ELSEIF type=IDCMP_CLOSEWINDOW
  1262.                 SELECT win
  1263.                 CASE regwnd;    closeregwindow();    type:=0
  1264.                 CASE varwnd;    closevarwindow();    type:=0
  1265.                 CASE srcwnd;    closesrcwindow();    type:=0
  1266.                 CASE mainwnd;    id:="ex"
  1267.                 ENDSELECT
  1268.             ELSEIF type=IDCMP_NEWSIZE
  1269.                 type:=0
  1270.                 SELECT win
  1271.                 CASE regwnd;    UpdateRegs()
  1272.                 CASE varwnd;    UpdateVars()
  1273.                 CASE srcwnd;    UpdateSrc()
  1274.                 ENDSELECT
  1275.             ELSE
  1276.                 type:=0
  1277.             ENDIF
  1278.             GT_ReplyIMsg(mes)
  1279.             SELECT id
  1280.             CASE "REGS"
  1281.                 IFN regwnd THEN openregwindow() ELSE closeregwindow()
  1282.                 id:=0
  1283.                 type:=0
  1284.             CASE "VARS"
  1285.                 IFN varwnd THEN openvarwindow() ELSE closevarwindow()
  1286.                 id:=0
  1287.                 type:=0
  1288.             CASE "FIND"
  1289.                 Find()
  1290.                 id:=0
  1291.                 type:=0
  1292.             CASE "NEXT"
  1293.                 Next()
  1294.                 id:=0
  1295.                 type:=0
  1296.             CASE "LINE"
  1297.                 Line()
  1298.                 id:=0
  1299.                 type:=0
  1300.             CASE "REFR"
  1301.                 Update()
  1302.                 id:=0
  1303.                 type:=0
  1304.             CASE "QUIT"
  1305.                 closesrcwindow()
  1306.                 closevarwindow()
  1307.                 closeregwindow()
  1308.             ENDSELECT
  1309.         ELSE
  1310.             IF wait THEN WaitPort(win.UserPort) ELSE type:=TRUE
  1311. /*
  1312.             DEF    sigbits
  1313.             IF wait
  1314.                 sigbits:=1<<mainwnd.UserPort.SigBit
  1315.                 sigbits!=1<<regwnd.UserPort.SigBit
  1316.                 sigbits!=1<<varwnd.UserPort.SigBit
  1317.                 sigbits!=1<<srcwnd.UserPort.SigBit
  1318.                 Wait(sigbits)
  1319.             ENDIF
  1320. */
  1321.         ENDIF
  1322.     UNTIL type
  1323. ENDPROC id
  1324.  
  1325. DEF    find_str[64]:CHAR,find_start=0
  1326.  
  1327. PROC Find()
  1328.     find_start:=0
  1329.     StrCopy(find_str,'')
  1330.     rtGetStringA(find_str,64,'Enter a text to find:',0,0)
  1331.     IF StrLen(find_str)=0
  1332.         DisplayBeep(NIL)
  1333.         RETURN
  1334.     ENDIF
  1335.     Next()
  1336. ENDPROC
  1337.  
  1338. PROC Next()
  1339.     DEF    line=find_start
  1340.     WHILE line<exe.src.linecount
  1341.         IF InStr(exe.src.lines[line],find_str)<>TRUE
  1342.             find_start:=line+1
  1343.             exe.src.showline:=line
  1344.             UpdateSrc()
  1345.             exe.src.showline:=-1
  1346.             RETURN
  1347.         ENDIF
  1348.         line++
  1349.     ENDWHILE
  1350.     IF line=>exe.src.linecount
  1351.         DisplayBeep(NIL)
  1352.         find_start:=0
  1353.     ENDIF
  1354. ENDPROC
  1355.  
  1356. DEF    line_jump=-1
  1357.  
  1358. PROC Line()
  1359.     line_jump:=exe.src.line+1
  1360.     rtGetLongA(&line_jump,'Enter a line number:',0,0)
  1361.     IF line_jump<0 OR line_jump>=exe.src.linecount
  1362.         line_jump:=exe.src.line+1
  1363.         DisplayBeep(NIL)
  1364.         RETURN
  1365.     ENDIF
  1366.     exe.src.showline:=line_jump-1
  1367.     UpdateSrc()
  1368.     exe.src.showline:=-1
  1369. ENDPROC
  1370.